home *** CD-ROM | disk | FTP | other *** search
/ El Mac 9 / El Mac 9.iso / Shareware / Applications / MathPad 2.4 / XFuns / XFun kit / histogram src / histogram.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-03-26  |  1.8 KB  |  74 lines  |  [TEXT/CWIE]
  1. /* an example of an XFun that operates on arrays.
  2.    Accumulates a histogram given an array of values. */
  3.  
  4. #include "callback.h"
  5.  
  6. static short histogram(double *retval,funptr callback)
  7. {
  8.    EXPR arr;
  9.    double *iptr,*bins,num,binlo,binhi,scl;
  10.    long ndata,i,nbins;
  11.    double sum;
  12.    short isarray;
  13.  
  14.    if(!GetParmVal(2,&binlo,callback)) return(FALSE);
  15.    if(!GetParmVal(1,&binhi,callback)) return(FALSE);
  16.    if(!GetParmVal(0,&num,callback)) return(FALSE);
  17.    nbins = num;
  18.    if(nbins <= 0 || binlo == binhi)
  19.    {
  20.     ErrMsg(" illegal parameter value",0,callback);
  21.     return(FALSE);
  22.    }
  23.    
  24.    MakeParmExpr(3,&arr,callback);
  25.    ProbeExpr(arr,&num,&isarray,&ndata,callback);
  26.    if(!isarray || !ndata)        /* expecting a finite array */
  27.    {
  28.     ErrMsg(" histogram(?,…) array size?",0,callback);
  29.     FreeExpr(arr,callback);
  30.     return(FALSE);
  31.    }
  32.  
  33.    scl = nbins/(binhi-binlo);
  34.    bins = (double *)NewPtrClear(nbins*sizeof(double));
  35.    if(!bins)
  36.    {
  37.     ErrMsg(" not enough memory",0,callback);
  38.     FreeExpr(arr,callback);
  39.     return(FALSE);
  40.    }
  41.    
  42.    AddIndex(&arr,&iptr,callback);
  43.    
  44.    sum = 0;
  45.    *retval = 0;
  46.    *iptr = 1;
  47.    while(ndata--)
  48.    {
  49.     if(EvalExpr(arr,&num,callback))        /* evaluate arr[*iptr] */
  50.     {
  51.      i = (num-binlo)*scl;
  52.      if(i>=0 && i<nbins)
  53.      {
  54.       bins[i] += 1;
  55.       *retval += 1;                /* function return value is total points within range */
  56.       sum += num;
  57.      }
  58.     }
  59.     *iptr += 1;
  60.     if(Stopped(callback)) break;            /* exit loop if problems */
  61.    }
  62.    FreeExpr(arr,callback);
  63.    SetVarMatrix("bins",bins,nbins,0,callback);    /* return histogram in global array "bins" */
  64.    SetVarVal("mean",sum / *retval,callback);        /* return mean in global "mean" */
  65.    return(TRUE);
  66. }
  67.  
  68. main(funptr callback)
  69. {
  70.    AddXfun("histogram","array,lo,hi,nbins",&histogram,0,callback);
  71. }
  72.  
  73.  
  74.